perm filename DESTRU.3[AID,LSP] blob
sn#420607 filedate 1979-02-22 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 (defun destructure (l)
C00004 ENDMK
Cā;
;(defun destructure (l)
; (destructure1 l nil))
(defun %%destructure1%% (l path)
(cond ((null l) nil)
((atom l)(ncons (cons l path)))
(t (append (%%destructure1%% (car l) (cons 'car path))
(%%destructure1%% (cdr l) (cons 'cdr path))))))
(defun %%destructurify%% (vars vals)
(mapcar
(function
(lambda (q r)
(cond ((atom q)
(list q r nil))
((atom r)
(list nil nil (%%pathify%% (%%destructure1%% q nil) r)))
(t ((lambda (g)
(list g r (%%pathify%% (%%destructure1%% q nil) g)))
(gensym))))))
vars vals))
(defun %%pathify%% (path gen)
(mapcar
(function
(lambda (q)
(list (car q) (%%code-path%% (cdr q) gen))))
path))
(defun %%code-path%% (path name)
(cond ((null path) name)
(t (list (car path) (%%code-path%% (cdr path) name)))))